home *** CD-ROM | disk | FTP | other *** search
/ Sprite 1984 - 1993 / Sprite 1984 - 1993.iso / lib / tcl / mkindex.tcl < prev    next >
Encoding:
Text File  |  1991-12-16  |  1.6 KB  |  51 lines
  1. # auto_mkindex:
  2. # Given a directory and a glob-style specification for files in that
  3. # directory, generate a "tclIndex" file in the directory that is suitable
  4. # for use in auto-loading.  Returns a null string.
  5. #
  6. # $Header: /user6/ouster/tcl/scripts/RCS/mkindex.tcl,v 1.2 91/12/16 08:29:25 ouster Exp $ SPRITE (Berkeley)
  7. #
  8. # Copyright 1991 Regents of the University of California
  9. # Permission to use, copy, modify, and distribute this
  10. # software and its documentation for any purpose and without
  11. # fee is hereby granted, provided that this copyright
  12. # notice appears in all copies.  The University of California
  13. # makes no representations about the suitability of this
  14. # software for any purpose.  It is provided "as is" without
  15. # express or implied warranty.
  16. #
  17.  
  18. proc auto_mkindex {dir files} {
  19.     global errorCode errorInfo
  20.     set oldDir [pwd]
  21.     cd $dir
  22.     set dir [pwd]
  23.     append index "# Tcl autoload index file: each line identifies a Tcl\n"
  24.     append index "# procedure and the file where that procedure is\n"
  25.     append index "# defined.  Generated by the \"auto_mkindex\" command.\n"
  26.     append index "\n"
  27.     foreach file [glob $files] {
  28.     set f ""
  29.     set error [catch {
  30.         set f [open $file]
  31.         while {[gets $f line] >= 0} {
  32.         if [regexp {^proc[     ]+([^     ]*)} $line match procName] {
  33.             append index "[list $procName $file]\n"
  34.         }
  35.         }
  36.         close $f
  37.     } msg]
  38.     if $error {
  39.         set code $errorCode
  40.         set info $errorInfo
  41.         catch [close $f]
  42.         cd $oldDir
  43.         error $msg $info $code
  44.     }
  45.     }
  46.     set f [open tclIndex w]
  47.     puts $f $index nonewline
  48.     close $f
  49.     cd $oldDir
  50. }
  51.